The Atari Compendium/The Atari Compendium (Toad Computers) (1994).iso/files/prgtools/programm.ing/m2posx10.zoo/m2posix.10/src/sys.ipp

Modula Implementation | 1993-12-23 | 5.9 KB | 242 lines

IMPLEMENTATION MODULE sys;
__IMP_SWITCHES__
#ifdef HM2
#ifdef __LONG_WHOLE__
(*$!i+: Modul muss mit $i- uebersetzt werden! *)
(*$!w+: Modul muss mit $w- uebersetzt werden! *)
#else
(*$!i-: Modul muss mit $i+ uebersetzt werden! *)
(*$!w-: Modul muss mit $w+ uebersetzt werden! *)
#endif
#endif
(*****************************************************************************)
(* Basiert auf der MiNTLIB von Eric R. Smith und anderen                     *)
(* --------------------------------------------------------------------------*)
(* 08-Dez-93, Holger Kleinschmidt                                            *)
(*****************************************************************************)

VAL_INTRINSIC
CAST_IMPORT

FROM SYSTEM IMPORT
(* TYPE *) ADDRESS,
(* PROC *) ADR;

FROM PORTAB IMPORT
(* TYPE *) UNSIGNEDWORD, SIGNEDLONG;

FROM MEMBLK IMPORT
(* PROC *) memalloc, memdealloc;

FROM ctype IMPORT
(* PROC *) todigit;

FROM types IMPORT
(* CONST*) ClkTck,
(* TYPE *) timeCast, StrPtr, StrRange, PathName, sizeT, timeT;

FROM OSCALLS IMPORT
(* PROC *) Dpathconf, Sysconf, Tgettime, Tgetdate;

IMPORT e;

FROM pSTRING IMPORT
(* PROC *) SLEN;

FROM DosSystem IMPORT
(* TYPE *) CPUType, MachineType, OsPtr, OsHeader,
(* PROC *) CPU, Machine, GetOsHeader, MiNTVersion;

FROM DosSupport IMPORT
(* CONST*) DINCR,
(* PROC *) UnixToDos;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)

CONST
  EOKL = LIC(0);

VAR
  uts  : UtsnameRec;
  MiNT : CARDINAL;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)

PROCEDURE uname ((* --/AUS *) VAR name : UtsnameRec ): INTEGER;
BEGIN
 name := uts;
 RETURN(0);
END uname;

(*---------------------------------------------------------------------------*)

PROCEDURE pathconf ((* EIN/ -- *) REF file  : ARRAY OF CHAR;
                    (* EIN/ -- *)     which : PConfVal      ): SIGNEDLONG;

VAR dot   : BOOLEAN;
    done  : BOOLEAN;
    limit : SIGNEDLONG;
    stack : ADDRESS;
    msize : CARDINAL;
    path0 : StrPtr;

BEGIN
 IF MiNT > 0 THEN
   msize := SLEN(file) + DINCR;
   memalloc(VAL(sizeT,msize), stack, path0);
   UnixToDos(file, msize - DINCR, VAL(StrRange,msize), path0, dot, done);
   IF NOT done THEN
     memdealloc(stack);
     RETURN(-1);
   END;
   CASE which OF
     pcMaxCanon : limit := -1; (* ?? *)
    |pcMaxInput : limit := -1; (* ?? *)
    |pcChownRestricted: limit := 0; (* ja *)
    |pcVdisable : limit := 0;
   ELSE
     IF NOT Dpathconf(path0, INT(which)+1, limit) THEN
       e.errno := INT(limit);
       limit   := -1;
     ELSIF which = pcNoTrunc THEN
       IF limit > LIC(0) THEN
         limit := -1; (* <=> Dateinamen werden gekuerzt *)
       ELSE
         limit := 0;
       END;
     END;
   END;
   memdealloc(stack);
   RETURN(limit);
 ELSE (* NOT MiNT *)
   CASE which OF
     pcLinkMax  : RETURN(1);
    |pcPathMax  : RETURN(128);
    |pcNameMax  : RETURN(12);
    |pcNoTrunc  : RETURN(-1); (* -1 <=> es wird gekuerzt *)
    |pcVdisable : RETURN(0);
    |pcMaxInput : RETURN(-1); (* ? *)
    |pcMaxCanon : RETURN(-1); (* ? *)
   ELSE (* pcPipeBuf, pcChownRestricted... *)
     e.errno := e.EINVAL;
     RETURN(-1);
   END;
 END;
END pathconf;

(*---------------------------------------------------------------------------*)

PROCEDURE sysconf ((* EIN/ -- *) which : SConfVal ): SIGNEDLONG;

VAR limit : SIGNEDLONG;

BEGIN
 IF which = scVersion THEN
   e.errno := e.EINVAL;
   RETURN(-1);
 END;
 IF MiNT > 0 THEN
   CASE which OF
     scArgMax     : RETURN(UNLIMITED); (* wegen "ARGV" *)
    |scClkTck     : RETURN(ClkTck);
    |scJobControl : RETURN(1);  (* ja *)
    |scSavedIds   : RETURN(-1); (* nein ?? *)
   ELSE
     IF Sysconf(INT(which)+1, limit) THEN
       RETURN(limit);
     ELSE
       e.errno := INT(limit);
       RETURN(-1);
     END;
   END;
 ELSE
   CASE which OF
     scArgMax     : RETURN(UNLIMITED); (* wegen "ARGV" *)
    |scOpenMax    : RETURN(81);        (* max. Kennung = 80 *)
    |scNGroupsMax : RETURN(0);
    |scChildMax   : RETURN(UNLIMITED);
    |scClkTck     : RETURN(ClkTck);
    |scJobControl : RETURN(-1); (* kein ``Job Control'' *)
    |scSavedIds   : RETURN(-1); (* aber kein Fehler ! *)
   ELSE
     e.errno := e.EINVAL;
     RETURN(-1);
   END;
 END;
END sysconf;

(*---------------------------------------------------------------------------*)

PROCEDURE time ((* -- /AUS *) VAR time : timeT );
VAR tc : timeCast;
BEGIN
 tc.time := Tgettime();
 tc.date := Tgetdate();
 time    := tc.cmp;
END time;

(*---------------------------------------------------------------------------*)

PROCEDURE putvers (vers : CARDINAL; VAR str : ARRAY OF CHAR );

VAR __REG__ i  : UNSIGNEDWORD;
    __REG__ j  : UNSIGNEDWORD;
    __REG__ hi : CARDINAL;
    __REG__ lo : CARDINAL;
            s  : ARRAY [0..9] OF CHAR;

BEGIN
 hi := vers DIV 256;
 lo := vers MOD 256;
 i  := 0;
 REPEAT
   s[i] := todigit(lo MOD 10);
   lo   := lo DIV 10;
   INC(i);
 UNTIL lo = 0;
 IF i = 1 THEN
   s[i] := '0'; INC(i);
 END;
 s[i] := '.'; INC(i);
 REPEAT
   s[i] := todigit(hi MOD 10);
   hi   := hi DIV 10;
   INC(i);
 UNTIL hi = 0;
 j := 0;
 WHILE i > 0 DO
   DEC(i);
   str[j] := s[i];
   INC(j);
 END;
 str[j] := 0C;
END putvers;

(*===========================================================================*)

VAR hi, lo : CARDINAL;
    osP    : OsPtr;

BEGIN
 MiNT := MiNTVersion();
 WITH uts DO
   nodename := "";
   IF MiNT > 0 THEN
     sysname := "MiNT";
     putvers(MiNT, release);
   ELSE
     sysname := "TOS";
     release := "0.00";
   END;
   GetOsHeader(osP);
   putvers(VAL(CARDINAL,osP^.osVersion), version);
   CASE Machine() OF
     atariST  : machine := "atarist";
    |atariSTE : machine := "atariste";
    |atariTT  : machine := "ataritt";
   ELSE
                machine := "atari";
   END;
 END; (* WITH *)
END sys.